Shareware Grab Bag/Shareware Grab Bag.iso/015/printpak.lbr/PRINTPAK.PQS/printpak.pas

Pascal/Delphi Source File | 1985-11-02 | 5KB | 187 lines

{-------------------------------------------------------------------}
{  High resolution graphics for Epson printers                      }
{                                                                   }
{  From:  Bridger, M and M Goresky  "High-Resolution Printer        }
{           Graphics", Byte, vol. 10, no. 12, November 1985,        }
{           pp. 219-232                                             }
{-------------------------------------------------------------------}
const
    across = 1599;
    down   =   39;

type
    data_type  = array[0..across,0..down] of char;
    mask_array = array[0..7] of byte;

var
    Evenmap, Oddmap: ^data_type;
    M, R: mask_array;


procedure Init_mem;

var  I, J: integer;

begin  { Init_mem }

    new (Evenmap);                      {  Set aside space in       }
    new (Oddmap);                       {    memory for arrays      }

    for J := 0 to down do
        for I := 0 to across do begin
            oddmap^[I,J]  := chr(0);    {  Initialize both arrays   }
            evenmap^[I,J] := chr(0)     {    to all bytes = 0       }
        end

end;  { Init_mem }


procedure Printout;

var  n_lo, n_hi: byte;
     I, J:       integer;

begin  { Printout }

    n_hi := (across+1) div 256;
    n_lo := (across+1) mod 256;

    for J := 0 to down do begin

        {  Enter graphics mode, give number of bytes coming         }
        write (Lst, chr(27), 'Z', chr(n_lo), chr(n_hi));
        for I := 0 to across do
            write (Lst, evenmap^[I,J]);     {  print even row       }
        write (Lst, chr(13));               {  carriage return      }
        write (Lst, chr(27), '3', chr(1));  {  set LF to 1/3 dot    }
        write (Lst, chr(10));               {  linefeed             }

        {  Enter graphics mode, give number of bytes coming         }
        write (Lst, chr(27), 'Z', chr(n_lo), chr(n_hi));
        for I := 0 to across do
            write (Lst, oddmap^[I,J]);      {  print odd row        }
        write (Lst, chr(13));               {  carriage return      }
        write (Lst, chr(27), '3', chr(22)); {  set LF to 7 1/3 dots }
        write (Lst, chr(10))                {  linefeed             }

    end
end;  { Printout }


procedure PixelMasks;

var  I: integer;

begin  { PixelMasks }

    M[7] := 1;
    for I := 6 downto 0 do
        M[I] := 2 * M[I+1];
    for I := 0 to 7 do
        R[I] := 255 - M[I]

end;  { PixelMasks }


{  Change given byte from present value to given value = color      }
procedure Change (var Char_byte: char;  color, height: integer);

var  Old: integer;

begin  { Change }

    Old := ord (Char_byte);
    case color of
        1:  Old := Old OR M[height];        {  Insert set bit using }
        0:  Old := Old AND R[height]        {    proper pixel mask  }
    end;
    Char_byte := chr(Old)

end;  { Change }


{  Writes dot at position (x,y) in memory arrays                    }
procedure Pset (x, y, color: integer);

var  I, line, height: integer;

begin  { Pset }

    {  Draw dot on screen, scaling by ratio of printer width and    }
    {    height to screen width and height                          }
    Plot (x * 2 div 5, y * 5 div 16, white);

    color  := color mod 2;
    line   := y div 16;             {  vertical position of pixel   }
    height := (y mod 16) div 2;     {   consists of line and height }

    if (y mod 2 = 0) then
        change (evenmap^[x,line], color, height)
    else
        change (oddmap^[x,line], color, height);

end;  { Pset }


{  Bresenham's line drawing algorithm                               }
procedure Pixel_Line (x1, y1, x2, y2: integer);

var  x, y, z, a, b, dx, dy, d, deltap, deltaq: integer;

begin  { Pixel_Line }

    dx := abs (x2 - x1);
    dy := abs (y2 - y1);

    if (dy <= dx) then begin                        {  Slope <= 1   }
        x := x1;  y := y1;  z := x2;
        if (x1 <= x2)
            then  a := 1
            else  a := -1;
        if (y1 <= y2)
            then  b := 1
            else  b := -1;

        deltap := dy + dy;
        d      := deltap - dx;
        deltaq := d - dx;

        Pset (x, y, 1);
        while (x <> z) do begin
            x := x + a;
            if (d < 0) then
                d := d + deltap
            else begin
                y := y + b;
                d := d + deltaq
            end;
            Pset (x, y, 1)
        end
    end
    else begin          {  dx <= dy, so view x as a function of y   }
        y := y1;  x := x1;  z := y2;
        if (y1 <= y2)
            then  a := 1
            else  a := -1;
        if ( x1 <= x2)
            then  b := 1
            else  b := -1;

        deltap := dx + dx;
        d      := deltap - dy;
        deltaq := d - dy;

        Pset (x, y, 1);
        while (y <> z) do begin
            y:= y + a;
            if (d < 0) then
                d := d + deltap
            else begin
                x := x + b;
                d := d + deltaq
            end;
            Pset (x, y, 1)
        end
    end

end;  { Pixel_Line }